unit Common.Log;

interface

uses System.SysUtils, System.Classes, System.SyncObjs, Rest.Json,
    System.IOUtils, System.Math;

type

    TLogType = (ltHint, ltWarn, ltError);

    TLogRecord = class
    private
        fLogTime: TDateTime;
        fLogType: TLogType;
        fLogText: String;
    protected
        property logType: TLogType read fLogType write fLogType;
        property logTime: TDateTime read fLogTime write fLogTime;
        property logText: String read fLogText write fLogText;
    end;

    TLogConfigSub = class(TPersistent)
    private
        fMaxFileCount: Integer;
        fEnable: Boolean;
        fMaxFileSize: Integer;
    public
        constructor Create;
        procedure AssignTo(Dest: TPersistent); override;
    published
        property Enable: Boolean read fEnable write fEnable;
        property MaxFileSize: Integer read fMaxFileSize write fMaxFileSize;
        property MaxFileCount: Integer read fMaxFileCount write fMaxFileCount;
    end;

    TLogConfig = class(TPersistent)
    private
        fWarnConfig: TLogConfigSub;
        fHintConfig: TLogConfigSub;
        fErrorConfig: TLogConfigSub;
        procedure setErrorConfig(const Value: TLogConfigSub);
        procedure setWarnConfig(const Value: TLogConfigSub);
        procedure setHintConfig(const Value: TLogConfigSub);

    public
        constructor Create();
        destructor Destroy(); override;
        class function LoadFromStream(Stream: TStringStream): TLogConfig;
        class function LoadFromFile(const FileName: String): TLogConfig;
        procedure SaveToStream(Stream: TStream);
        procedure SaveToFile(const FileName: String);
    published
        property HintConfig: TLogConfigSub read fHintConfig write setHintConfig;
        property WarnConfig: TLogConfigSub read fWarnConfig write setWarnConfig;
        property ErrorConfig: TLogConfigSub read fErrorConfig
          write setErrorConfig;
    end;

    TLogFile = record
    private
    public
        class procedure Log(logText: String; logType: TLogType); static;
        class procedure Hint(logText: String); static;
        class procedure Error(logText: String); overload; static;
        class procedure Error(Error: Exception); overload; static;
        class procedure Warn(logText: String); static;
        class operator GreaterThan(logFile: TLogFile; logText: String)
          : TLogFile;
        procedure W(logText: String);
        procedure E(logText: String);
        procedure H(logText: String);
    end;

    TWriteThread = class(TThread)
    protected
        procedure CheckAndDeleteFile();
        procedure Execute(); override;
    end;

var
    GLog: TLogFile;

implementation

uses Common.List;

var
    writeThread: TWriteThread;
    Logs: TLinkedList;
    FreedLogs: TLinkedList;
    logConfig: TLogConfig;
    HFileIndex: Integer;
    WFileIndex: Integer;
    EFileIndex: Integer;
    LogPath: String;
    Locker: TEvent;

    { TWriteThread }

procedure TWriteThread.CheckAndDeleteFile;
var
    WFileList: TStringList;
    HFileList: TStringList;
    EFileList: TStringList;
    I, Index, nCount: Integer;
    nMax: Integer;
    nMin: Integer;
    FileName: String;
begin
    WFileList := TStringList.Create;
    HFileList := TStringList.Create;
    EFileList := TStringList.Create;
    WFileList.AddStrings(TDirectory.GetFiles(LogPath, 'warn-*.log'));
    HFileList.AddStrings(TDirectory.GetFiles(LogPath, 'hint-*.log'));
    HFileList.AddStrings(TDirectory.GetFiles(LogPath, 'error-*.log'));
    WFileList.Sort();
    HFileList.Sort();
    EFileList.Sort();

    nMax := 0;
    nMin := Integer.MaxValue;
    for I := 0 to WFileList.Count - 1 do
    begin
        index := StrToIntDef(WFileList[I], 0);
        nMax := Max(index, nMax);
        nMin := Min(index, nMin);
    end;

    if (WFileList.Count > logConfig.WarnConfig.MaxFileCount) then
    begin
        nCount := WFileList.Count - logConfig.WarnConfig.MaxFileCount;
        for I := 0 to nCount - 1 do
        begin
            index := nMin + I;
            FileName := LogPath + 'warn-' + inttostr(index) + '.log';
            if TFile.Exists(FileName) then
            begin
                TFile.Delete(FileName);
            end;
        end;
    end;

    nMax := 0;
    nMin := Integer.MaxValue;
    for I := 0 to HFileList.Count - 1 do
    begin
        index := StrToIntDef(HFileList[I], 0);
        nMax := Max(index, nMax);
        nMin := Min(index, nMin);
    end;

    if (HFileList.Count > logConfig.HintConfig.MaxFileCount) then
    begin
        nCount := HFileList.Count - logConfig.HintConfig.MaxFileCount;
        for I := 0 to nCount - 1 do
        begin
            index := nMin + I;
            FileName := LogPath + 'hint-' + inttostr(index) + '.log';
            if TFile.Exists(FileName) then
            begin
                TFile.Delete(FileName);
            end;
        end;
    end;

    nMax := 0;
    nMin := Integer.MaxValue;
    for I := 0 to EFileList.Count - 1 do
    begin
        index := StrToIntDef(EFileList[I], 0);
        nMax := Max(index, nMax);
        nMin := Min(index, nMin);
    end;

    if (EFileList.Count > logConfig.ErrorConfig.MaxFileCount) then
    begin
        nCount := EFileList.Count - logConfig.ErrorConfig.MaxFileCount;
        for I := 0 to nCount - 1 do
        begin
            index := nMin + I;
            FileName := LogPath + 'Error-' + inttostr(index) + '.log';
            if TFile.Exists(FileName) then
            begin
                TFile.Delete(FileName);
            end;
        end;
    end;

    WFileList.Free;
    HFileList.Free;
    EFileList.Free;

end;

procedure TWriteThread.Execute;
var
    Rec: TLogRecord;
    FileName: String;
    fileHandle: TextFile;
    strLog, logType: String;
    Enable: Boolean;
    MaxFileSize: Integer;
    wCount: Integer;
begin
    wCount := 0;
    MaxFileSize := 100;
    NameThreadForDebugging('LogThread');
    while not Terminated do
    begin
        Rec := Logs.RemoveFirst();
        if (not assigned(Rec)) then
        begin
            if (Locker.WaitFor() = wrSignaled) then
            begin
                Locker.ResetEvent;
                continue;
            end;
        end;
        inc(wCount);
        Enable := false;
        case Rec.logType of
            ltHint:
                if logConfig.HintConfig.Enable then
                begin
                    FileName := LogPath + 'hint-' +
                      inttostr(HFileIndex) + '.log';
                    logType := 'hint';
                    MaxFileSize := logConfig.HintConfig.MaxFileSize;
                    Enable := true;
                end;
            ltWarn:
                if logConfig.WarnConfig.Enable then
                begin
                    FileName := LogPath + 'warn-' +
                      inttostr(WFileIndex) + '.log';
                    logType := 'warn';
                    MaxFileSize := logConfig.WarnConfig.MaxFileSize;
                    Enable := true;
                end;
            ltError:
                if logConfig.ErrorConfig.Enable then
                begin
                    FileName := LogPath + 'error-' +
                      inttostr(EFileIndex) + '.log';
                    logType := 'error';
                    MaxFileSize := logConfig.ErrorConfig.MaxFileSize;
                    Enable := true;
                end;
        end;
        if Enable then
        begin
            AssignFile(fileHandle, FileName);
            try
                if TFile.Exists(FileName) then
                begin
                    append(fileHandle);
                end
                else
                begin
                    rewrite(fileHandle);
                end;
                strLog := formatDatetime('yyyy-MM-dd HH:mm:ss.zzz', Rec.logTime)
                  + ' ' + logType + ' ' + Rec.logText;
                writeln(fileHandle, strLog);
                if wCount mod 100 = 0 then
                begin
                    if (MaxFileSize < FileSize(fileHandle)) then
                    begin
                        case Rec.logType of
                            ltHint:
                                begin
                                    inc(HFileIndex);
                                end;
                            ltWarn:
                                begin
                                    inc(WFileIndex);
                                end;
                            ltError:
                                begin
                                    inc(EFileIndex);
                                end;
                        end;
                    end;

                    CheckAndDeleteFile();
                end;
            finally
                CloseFile(fileHandle);
            end;
        end;
    end;
end;

{ TLogFile }

procedure TLogFile.E(logText: String);
begin
    TLogFile.Error(logText);
end;

class procedure TLogFile.Error(logText: String);
begin
    Log(logText, TLogType.ltError);
end;

procedure TLogFile.H(logText: String);
begin
    TLogFile.Hint(logText);
end;

class procedure TLogFile.Hint(logText: String);
begin
    Log(logText, TLogType.ltHint);
end;

class procedure TLogFile.Log(logText: String; logType: TLogType);
var
    Rec: TLogRecord;
begin
    Rec := FreedLogs.RemoveFirst();
    if not assigned(Rec) then
    begin
        Rec := TLogRecord.Create;
    end;

    Rec.fLogType := logType;
    Rec.fLogTime := now;
    Rec.fLogText := logText;

    Logs.append(Rec);
    Locker.SetEvent;
end;

class procedure TLogFile.Error(Error: Exception);
begin
    TLogFile.Error(Error.Message+Error.StackTrace);
end;

class operator TLogFile.GreaterThan(logFile: TLogFile; logText: String)
  : TLogFile;
begin
    TLogFile.Log(logText, TLogType.ltHint);
    result := logFile;
end;

procedure TLogFile.W(logText: String);
begin
    TLogFile.Warn(logText);
end;

class procedure TLogFile.Warn(logText: String);
begin
    Log(logText, TLogType.ltWarn);
end;

procedure ClearLogsMemory();
var
    Rec: TLogRecord;
begin
    Rec := Logs.RemoveFirst();
    while (Rec <> nil) do
    begin
        Rec.Free;
        Rec := Logs.RemoveFirst();
    end;
    Rec := FreedLogs.RemoveFirst();
    while (Rec <> nil) do
    begin
        Rec.Free;
        Rec := FreedLogs.RemoveFirst();
    end;
end;

{ TLogConfig }

constructor TLogConfig.Create;
begin
    inherited Create();
    fHintConfig := TLogConfigSub.Create;
    fWarnConfig := TLogConfigSub.Create;
    fErrorConfig := TLogConfigSub.Create;
end;

destructor TLogConfig.Destroy;
begin
    fHintConfig.Free;
    fWarnConfig.Free;
    fErrorConfig.Free;
    inherited;
end;

class function TLogConfig.LoadFromFile(const FileName: String): TLogConfig;
var
    Stream: TStringStream;
begin
    result := nil;
    Stream := TStringStream.Create;
    try
        Stream.LoadFromFile(FileName);
        Stream.Position := 0;
        result := LoadFromStream(Stream);
    finally
        Stream.Free;
    end;
end;

class function TLogConfig.LoadFromStream(Stream: TStringStream): TLogConfig;
begin
    try
        result := TJson.JsonToObject<TLogConfig>(Stream.DataString);
    finally
        result := nil;
    end;
end;

procedure TLogConfig.SaveToFile(const FileName: String);
var
    Stream: TStringStream;
begin
    Stream := TStringStream.Create;
    try
        SaveToStream(Stream);
        Stream.Position := 0;
        Stream.SaveToFile(FileName);
    finally
        Stream.Free;
    end;
end;

procedure TLogConfig.SaveToStream(Stream: TStream);
var
    data: String;
    bts: TBytes;
begin
    try
        data := TJson.ObjectToJsonString(self);
        bts := TEncoding.UTF8.GetBytes(data);
        Stream.WriteData(bts, length(bts));
    finally
        setLength(bts, 0);
    end;
end;

procedure TLogConfig.setErrorConfig(const Value: TLogConfigSub);
begin
    fErrorConfig.Assign(Value);
end;

procedure TLogConfig.setHintConfig(const Value: TLogConfigSub);
begin
    fHintConfig.Assign(Value);
end;

procedure TLogConfig.setWarnConfig(const Value: TLogConfigSub);
begin
    fWarnConfig.Assign(Value);
end;

{ TLogConfigSub }

procedure TLogConfigSub.AssignTo(Dest: TPersistent);
begin
    if Dest is TLogConfigSub then
    begin
        TLogConfigSub(Dest).fMaxFileCount := fMaxFileCount;
        TLogConfigSub(Dest).fEnable := fEnable;
        TLogConfigSub(Dest).fMaxFileSize := fMaxFileSize;
    end
    else
        inherited;
end;

constructor TLogConfigSub.Create;
begin
    inherited Create;
    fEnable := true;
    fMaxFileSize := 1024 * 1024 * 50;
    fMaxFileCount := 20;
end;

procedure loadLogConfig();
var
    path: String;
begin
    path := ExtractFilePath(paramStr(0));
    if TFile.Exists((path + '.logconfig')) then
    begin
        logConfig := TLogConfig.LoadFromFile(path + '.logconfig');
    end;
    if not assigned(logConfig) then
    begin
        logConfig := TLogConfig.Create;
        logConfig.SaveToFile(path + '.logconfig');
    end;
end;

procedure loadIndex();
var
    WFileList: TStringList;
    HFileList: TStringList;
    EFileList: TStringList;
    I, Index: Integer;
    nMax: Integer;
begin
    WFileList := TStringList.Create;
    HFileList := TStringList.Create;
    EFileList := TStringList.Create;
    WFileList.AddStrings(TDirectory.GetFiles(LogPath, 'warn-*.log'));
    HFileList.AddStrings(TDirectory.GetFiles(LogPath, 'hint-*.log'));
    HFileList.AddStrings(TDirectory.GetFiles(LogPath, 'error-*.log'));
    WFileList.Sort();
    HFileList.Sort();
    EFileList.Sort();

    nMax := 0;
    for I := 0 to WFileList.Count - 1 do
    begin
        index := StrToIntDef(WFileList[I], 0);
        nMax := Max(index, nMax);
    end;
    WFileIndex := nMax +
      Integer(TFile.GetSize(LogPath + 'warn-' + inttostr(nMax) + '.log') >
      logConfig.WarnConfig.MaxFileSize);

    nMax := 0;
    for I := 0 to HFileList.Count - 1 do
    begin
        index := StrToIntDef(HFileList[I], 0);
        nMax := Max(index, nMax);
    end;
    HFileIndex := nMax +
      Integer(TFile.GetSize(LogPath + 'hint-' + inttostr(nMax) + '.log') >
      logConfig.HintConfig.MaxFileSize);

    nMax := 0;
    for I := 0 to EFileList.Count - 1 do
    begin
        index := StrToIntDef(EFileList[I], 0);
        nMax := Max(index, nMax);
    end;
    EFileIndex := nMax +
      +Integer(TFile.GetSize(LogPath + 'error-' + inttostr(nMax) + '.log') >
      logConfig.ErrorConfig.MaxFileSize);

    WFileList.Free;
    HFileList.Free;
    EFileList.Free;
end;

initialization

loadLogConfig();
Locker := TEvent.Create();

LogPath := ExtractFilePath(paramStr(0));
Logs := TLinkedList.Create();
FreedLogs := TLinkedList.Create;

loadIndex();

writeThread := TWriteThread.Create;

finalization

try
    if (assigned(writeThread)) then
    begin
        writeThread.Terminate();
    end;
except

end;

ClearLogsMemory();
Locker.Free;
logConfig.Free;
FreedLogs.Free;
Logs.Free;

end.
